home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / gentype / gentypes.frm < prev    next >
Text File  |  1995-05-08  |  8KB  |  305 lines
  1. VERSION 2.00
  2. Begin Form Form1 
  3.    Caption         =   "&Proceed"
  4.    ClientHeight    =   2835
  5.    ClientLeft      =   1500
  6.    ClientTop       =   1365
  7.    ClientWidth     =   7365
  8.    Height          =   3240
  9.    Left            =   1440
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   2835
  12.    ScaleWidth      =   7365
  13.    Top             =   1020
  14.    Width           =   7485
  15.    Begin Data Data1 
  16.       Caption         =   "Data1"
  17.       Connect         =   ""
  18.       DatabaseName    =   ""
  19.       Exclusive       =   0   'False
  20.       Height          =   270
  21.       Left            =   120
  22.       Options         =   0
  23.       ReadOnly        =   -1  'True
  24.       RecordSource    =   ""
  25.       Top             =   2460
  26.       Visible         =   0   'False
  27.       Width           =   1155
  28.    End
  29.    Begin CheckBox prtrep 
  30.       Caption         =   "Generate report <Databasename>.LST"
  31.       Height          =   435
  32.       Left            =   1560
  33.       TabIndex        =   6
  34.       Top             =   1020
  35.       Value           =   1  'Checked
  36.       Width           =   5415
  37.    End
  38.    Begin TextBox tabname 
  39.       BackColor       =   &H00C0C0C0&
  40.       Enabled         =   0   'False
  41.       Height          =   315
  42.       Left            =   1920
  43.       TabIndex        =   5
  44.       Text            =   "Working On Table:"
  45.       Top             =   2340
  46.       Width           =   3555
  47.    End
  48.    Begin CheckBox GenTypes 
  49.       Caption         =   "Output VB 3.0 TYPE statements to GENTYPES.LST"
  50.       Height          =   435
  51.       Left            =   1560
  52.       TabIndex        =   4
  53.       Top             =   600
  54.       Value           =   1  'Checked
  55.       Width           =   5415
  56.    End
  57.    Begin CommandButton Command2 
  58.       Caption         =   "&Quit"
  59.       Height          =   495
  60.       Left            =   4080
  61.       TabIndex        =   3
  62.       Top             =   1740
  63.       Width           =   2235
  64.    End
  65.    Begin CommandButton Prt 
  66.       Caption         =   "&Proceed"
  67.       Height          =   495
  68.       Left            =   1020
  69.       TabIndex        =   2
  70.       Top             =   1740
  71.       Width           =   2235
  72.    End
  73.    Begin TextBox Text1 
  74.       Height          =   315
  75.       Left            =   3180
  76.       TabIndex        =   0
  77.       Top             =   180
  78.       Width           =   2415
  79.    End
  80.    Begin Label Label1 
  81.       AutoSize        =   -1  'True
  82.       Caption         =   "Data Base to print:"
  83.       Height          =   195
  84.       Left            =   1500
  85.       TabIndex        =   1
  86.       Top             =   240
  87.       Width           =   1620
  88.    End
  89. End
  90. Option Explicit
  91.  
  92. Sub Command2_Click ()
  93. End
  94. End Sub
  95.  
  96. Sub Form_Load ()
  97.     Form1.Top = (screen.Height - Form1.Height) / 2
  98.     Form1.Left = (screen.Width - Form1.Width) / 2
  99.  
  100.  
  101. End Sub
  102.  
  103. Sub prt_Click ()
  104. Dim rp$
  105. Dim db As Database
  106. Dim tnames As snapshot
  107. Dim td As Table
  108. Dim fld As Fields
  109. Dim idx As Index
  110. Dim idxcnt As Integer
  111. Dim aq$
  112. Dim i
  113. Dim j
  114. Dim x$
  115. Dim aa$
  116. Dim qq
  117. Dim dset As DynaSet
  118.  
  119.  
  120.  
  121.     'on error GoTo ETrap
  122.     aq$ = text1.Text
  123.     If Len(aq$) = 0 Then
  124.     MsgBox "Please enter a data base name..."
  125.     text1.SetFocus
  126.     Exit Sub
  127.     End If
  128.     
  129.     x$ = Dir$(aq$)
  130.     If Len(x$) = 0 Then
  131.     MsgBox "Database : " + x$ + " not found on disk..."
  132.     text1.SetFocus
  133.     Exit Sub
  134.     End If
  135.  
  136.     prt.Enabled = False
  137.     If prtrep.Value = 1 Then
  138.     i = InStr(1, UCase(aq$), ".MDB")
  139.     rp$ = Mid$(aq$, 1, i) + "LST"
  140.     Open rp$ For Output As #22
  141.     End If
  142.     Set db = OpenDatabase(aq$)
  143.     Data1.DatabaseName = db.Name
  144.     Set tnames = db.ListTables() ' Copy Table info to td("
  145.     If GenTypes.Value = 1 Then
  146.     Open "gentypes.lst" For Output As #2
  147.     Print #2, "'Structures from data base: "; aq$; "as of: "; Date$; ", "; Time$
  148.     Print #2, ""
  149.     End If
  150.  
  151.     If prtrep.Value = 1 Then
  152.     
  153.     Print #22, "Listing of data base: "; aq$, "Date: "; Date$, "Time: "; Time$
  154.     Print #22,
  155.     Print #22, "Source of data: "; db.Name
  156.     Print #22, "Connect string: "; db.Connect
  157.     Print #22, "Transactions supported? "; db.Transactions
  158.     Print #22, "Sort Order: "; db.CollatingOrder
  159.     Print #22, "Updateable? "; db.Updatable
  160.     Print #22, "Query time-out (secs): "; db.QueryTimeout
  161.     Print #22,
  162.     Print #22, "Number of tables: "; Str$(db.TableDefs.Count)
  163.     Print #22,
  164.     End If
  165.     
  166.     Do While Not tnames.EOF
  167.     If (tnames("Attributes") And DB_SYSTEMOBJECT) <> 0 Then
  168.         GoTo SkipTd
  169.     End If
  170.     
  171.     aa$ = tnames("Name")
  172.     Data1.DatabaseName = db.Name
  173.     Data1.RecordSource = aa$
  174.     'On Error Resume Next
  175.     'Data1.recordset.QueryTimeout = 1
  176.     'qq = 1
  177.     Data1.Refresh
  178.     'qq = 1
  179.     'On Error GoTo ETrap
  180.     
  181.     If prtrep.Value = 1 Then
  182.         Print #22, String$(132, "=")
  183.         Print #22, "Table Name:      "; Data1.Recordset.Name
  184.         Print #22, "Updateable?:     "; Data1.Recordset.Updatable
  185.         Print #22, "Date Created:    "; tnames("DateCreated")
  186.         Print #22, "Last Updated:    "; tnames("LastUpdated")
  187.         Print #22, "Table Type:      ";
  188.         
  189.         
  190.         If (tnames("TableType") And DB_QUERYDEF) = DB_QUERYDEF Then
  191.          Print #22, "QUERYDEF"
  192.         Else
  193.         If (tnames("TableType") And DB_TABLE) = DB_TABLE Then
  194.             Print #22, "TABLE"
  195.             Set td = db.OpenTable(tnames("Name"))
  196.             idxcnt = td.Indexes.Count
  197.             Print #22, "Index count: "; Str$(idxcnt)
  198.             If idxcnt <> 0 Then
  199.                 For i = 0 To idxcnt - 1
  200.                 Set idx = td.Indexes(i)
  201.                 Print #22, "Index name: "; idx.Name
  202.                 Print #22, "    fields: "; idx.Fields
  203.                 Print #22, "   primary: ";
  204.                 If (idx.Primary) Then Print #22, "Yes" Else Print #22, "No"
  205.                 Print #22, "    unique: ";
  206.                 If (idx.Unique) Then Print #22, "Yes" Else Print #22, "No"
  207.                 Print #22, ""
  208.                 Next i
  209.             End If
  210.         Else
  211.             Print #22, "UNKNOWN"
  212.         End If
  213.         End If
  214.         Print #22,
  215.         Print #22, "Record Count:    "; tnames("RecordCount")
  216.         Print #22, "Attributes:      "; Hex$(tnames("Attributes"))
  217.         Print #22, "Fields:"
  218.         Print #22, String$(132, "_")
  219.         Print #22, "Name";
  220.         Print #22, Tab(30); "Type";
  221.         Print #22, Tab(45); "Size";
  222.         Print #22, Tab(50); "Attr";
  223.         Print #22, Tab(55); "C.O.";
  224.         Print #22, Tab(65); "OPos";
  225.         Print #22, Tab(70); "Source Field";
  226.         Print #22, Tab(90); "Source Table";
  227.         Print #22,
  228.         Print #22,
  229.     End If
  230.     If GenTypes.Value = 1 Then
  231.         Print #2, "'"; String$(80, "_")
  232.         Print #2, "Type td_" + tnames("Name")
  233.     End If
  234.     
  235.     tabname.Text = "Working on table: " + tnames("Name")
  236.     For j = 0 To Data1.Recordset.Fields.Count - 1
  237.         aq$ = ""
  238.         Select Case Data1.Recordset.Fields(j).Type
  239.         Case Is = 1, 2, 3
  240.         aq$ = "Integer"
  241.         Case Is = 4
  242.         aq$ = "Long"
  243.         Case Is = 5
  244.         aq$ = "Currency"
  245.         Case Is = 6
  246.         aq$ = "Single"
  247.         Case Is = 7, 8
  248.         aq$ = "Double"
  249.         Case Is = 9, 10
  250.         aq$ = "String * " + Str$(Data1.Recordset.Fields(j).Size)
  251.         Case Is = 11, 12
  252.         aq$ = "Long"
  253.         Case Else
  254.         aq$ = "UNKNOWN:" + Str$(Data1.Recordset.Fields(j).Type)
  255.         End Select
  256.         If GenTypes.Value = 1 Then
  257.         
  258.         Print #2, "        "; Data1.Recordset.Fields(j).Name; " AS ";
  259.         Print #2, aq$
  260.         End If
  261.         If Mid$(aq$, 1, 6) = "String" Then
  262.         aq$ = "String"
  263.         End If
  264.         If prtrep.Value = 1 Then
  265.         Print #22, Data1.Recordset.Fields(j).Name;
  266.         Print #22, Tab(30); aq$;
  267.         Print #22, Tab(45); Data1.Recordset.Fields(j).Size;
  268.         Print #22, Tab(50); Hex$(Data1.Recordset.Fields(j).Attributes);
  269.         Print #22, Tab(55); Str$(Data1.Recordset.Fields(j).CollatingOrder);
  270.         Print #22, Tab(65); Str$(Data1.Recordset.Fields(j).OrdinalPosition);
  271.         Print #22, Tab(70); Data1.Recordset.Fields(j).SourceField;
  272.         Print #22, Tab(90); Data1.Recordset.Fields(j).SourceTable
  273.         End If
  274.     Next j
  275.     If prtrep.Value = 1 Then
  276.         Print #22,
  277.         Print #22,
  278.     End If
  279.     If GenTypes.Value = 1 Then
  280.         Print #2, "END TYPE"
  281.     End If
  282. SkipTd:
  283.     'data1.Close
  284.  
  285.     tnames.MoveNext    ' Move to next record.
  286.     Loop
  287.     
  288.     If prtrep.Value = 1 Then
  289.     Print #22, "*** END OF REPORT ***"
  290.     printer.EndDoc
  291.     End If
  292.     Beep
  293.     Beep
  294.     MsgBox "Printing completed!"
  295.     End
  296. ETrap:
  297.     
  298.     aq$ = "An error occurred! " + Chr$(